home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Auge 4000 / Auge 4000 #21 (1988-05-25)(Amiga User Gruppe Einzugsgebiet 4000).zip / Auge 4000 #21 (1988-05-25)(Amiga User Gruppe Einzugsgebiet 4000).adf / Mastermind / Mastermind (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-01-20  |  10KB  |  462 lines
  1. ' Mastermind V1.0  860804
  2. '
  3. ' The good ol' game of Mastermind...
  4. ' It's the machine playing the scorekeeper and the ever-lasting oponent
  5. ' who does all of the puzzle choosing.  Choose between Mastermind and
  6. ' SUPER Mastermind (heh heh heh)
  7. '
  8. ' Programmed By Ken Robertson of Montreal, Quebec
  9. ' August 1st, 1986
  10. '
  11. ' 
  12. ' This program is FREEWARE and may be distributed without cost to anyone.
  13. ' However, if you like the game and would like to see more coming, feel
  14. ' free to send me a donation (I gotta eat, too) at
  15. '
  16. '     4130 Decarie, #11
  17. '     Montreal, Quebec,
  18. '     Canada
  19. '     H3A 2K1
  20. '
  21. ' I didn't put these comments in to print at the beginning as I feel
  22. ' that they're a little tacky to see, everytime the program comes up.
  23. '
  24. ' Any programs that begin with 'KenR Software Presents' was most probably
  25. ' written by me.  Expect good stuff.
  26. '
  27. DIM guess(5),rack(20,5),answer(5),unguess(5)
  28.  
  29. ' paint function key boxes for colours, cancel, and erase.
  30. RANDOMIZE TIMER
  31. SCREEN CLOSE 2
  32. SCREEN 2,640,200,4,2
  33. WINDOW 2,"Mastermind",,15,2
  34. PALETTE 0,0,0,0:PALETTE 1,0.7,0.7,0.7:PALETTE 8,0,0.5,0:PALETTE 10,1,1,0.13
  35. GOSUB drawcredits
  36. thesame=0
  37. FOR i=0 TO 9
  38. LINE (i*60-30*(i>4),174)-(i*60-30*(i>4)+40,186),i+3,bf
  39. NEXT i
  40. LINE (8*60+30,174)-(8*60+70,186),0,bf
  41.  
  42. LOCATE 23,73
  43. PRINT " Go ";
  44. topscore=99
  45.  
  46. LOCATE 1,1:PRINT "For instructions, press the 'Help' key now."
  47. firstime=1
  48. thesame=0
  49. startgame:
  50.  
  51. ' Generate permutation . . .
  52. answer(0)=0
  53. FOR i=1 TO 5
  54. test1:
  55.   g=INT(RND(1)*8)+1
  56.   IF thesame=0 THEN
  57.      testf=0
  58.      FOR j=0 TO i-1
  59.        IF g=answer(j) THEN testf=1
  60.      NEXT j
  61.      IF testf=1 THEN test1
  62.   END IF
  63.   answer(i)=g
  64. NEXT i
  65.  
  66. ' No two balls alike...
  67. guessnbr = 1
  68. ' draw rack
  69. FOR i=14 TO 550 STEP 29
  70.    LINE (i,14)-(i+29,77),1,b
  71. NEXT i
  72. notdone = -1
  73.  
  74. WHILE notdone
  75.  guessing = -1   
  76.  lastx=guessnbr*29
  77.  lasty=22
  78.  inpnbr = 1
  79.  WHILE guessing
  80.    CIRCLE (lastx,lasty),12,1
  81.    nochar=-1
  82.    WHILE nochar
  83.       a$=INKEY$
  84.       IF LEN(a$)<>0 THEN
  85.          a=ASC(a$)
  86.          IF a>128 AND a<140 THEN nochar=0
  87.          IF a=28 OR a=29 THEN nochar = 0
  88.          IF a=139 AND firstime=1 THEN GOSUB help
  89.       END IF
  90.    WEND
  91.    IF a<>139 AND a<>137 THEN firstime=0
  92.    IF a=139 AND firstime=0 THEN GOSUB hint
  93.    IF a=137 AND firstime THEN
  94.       thesame=1
  95.       COLOR 3
  96.       LOCATE 1,1
  97.       firstime=0
  98.       PRINT  "A more difficult game has just been chosen.  Pegs may now be the same color.";
  99.       GOTO startgame
  100.    END IF   
  101.    SOUND 220,0.31,127,0
  102.    SOUND 245,0.31,127,1
  103.  ' clear the first line of any message
  104.    LINE (0,0)-(639,9),0,bf  
  105.  '
  106.  '  A function key was pressed or an arrow key - is it a guess?
  107.  '  
  108.    IF a<137 AND a>128 THEN
  109.       ' Yep - add it to the list
  110.       rack (guessnbr,inpnbr)=a-128
  111.       'draw the circle
  112.       CIRCLE (lastx,lasty),11,a-126
  113.       PAINT (lastx,lasty),a-126
  114.       inpnbr=inpnbr + 1
  115.    END IF
  116.    
  117.    CIRCLE (lastx,lasty),12,0
  118.    IF a=28 THEN inpnbr=inpnbr-1
  119.    IF inpnbr=0 THEN inpnbr=1
  120.    IF a=29 THEN inpnbr=inpnbr+1
  121.    IF inpnbr = 6 THEN inpnbr = 1
  122.    lastx=guessnbr*29:lasty=inpnbr*12+10
  123.    CIRCLE (lastx,lasty),12,1
  124.  
  125.         
  126.    IF a=138 THEN
  127.       n=1
  128.       FOR i=1 TO 5
  129.          n=n*rack(guessnbr,i)
  130.       NEXT i
  131.       IF n<>0 THEN   
  132.          guessing=0
  133.       ELSE
  134.          LOCATE 1,1
  135.          COLOR 3
  136.          PRINT  "You must finish guessing before you 'Go'.";
  137.          SOUND 200,3,127,0
  138.          SOUND 210,3,127,1
  139.          SOUND 150,3,127,0
  140.          SOUND 160,3,127,1
  141.       END IF
  142.    END IF
  143.               
  144.  WEND  
  145.  'An input has been entered!  Check it against the answer
  146.  CIRCLE (lastx,lasty),12,0
  147.  FOR i=1 TO 5:guess(i)=answer(i):unguess(i)=rack(guessnbr,i):NEXT i
  148.  white=0:black=0
  149.  FOR i=1 TO 5
  150.    FOR j=1 TO 5
  151.       IF unguess(i)=guess(j) AND i=j THEN black=black+1:guess(j)=0:unguess(i)=99     
  152.    NEXT j
  153.  NEXT i
  154.  
  155.  FOR i=1 TO 5  
  156.    FOR j=1 TO 5
  157.      IF unguess(i)=guess(j) THEN white=white+1:guess(j)=0:unguess(i)=99
  158.    NEXT j
  159.  NEXT i
  160.  
  161.  ' ok - blacks and whites are summed up
  162.  IF black>0 THEN
  163.     FOR i=1 TO black
  164.       CIRCLE (guessnbr*29,75+6*i),5,1
  165.       SOUND 800,0.1,127,0
  166.       SOUND 810,0.1,127,0
  167.     NEXT i
  168.  END IF
  169.  
  170.  IF white > 0 THEN
  171.     FOR i=1 TO white
  172.        CIRCLE (guessnbr*29,75+6*black+6*i),5,7
  173.        PAINT (guessnbr*29,75+6*black+6*i),7
  174.        SOUND 500,0.1,127,0
  175.        SOUND 510,0.1,127,1
  176.     NEXT i
  177.  END IF
  178.  
  179.  LINE (14+(guessnbr-1)*29,77)-(guessnbr*29+14,110),1,b          
  180.  
  181.  guessnbr = guessnbr + 1
  182.  
  183.  IF black=5 THEN notdone = 0
  184.  IF guessnbr=20 THEN notdone=0
  185.  
  186. WEND
  187.  
  188. LOCATE 1,1
  189. IF guessnbr=20 AND black=5 THEN
  190.    FOR i=500 TO 100 STEP -10
  191.       SOUND i,0.1,100,0
  192.       SOUND i,0.1,100,1
  193.    NEXT i
  194.    PRINT "Wow.  You just got lucky, I guess.";
  195. END IF
  196.  
  197. IF guessnbr=20 AND black<5 THEN
  198.    SOUND 200,10,100,0
  199.    SOUND 300,10,100,1
  200.  
  201.    PRINT "Sorry, you've run out of turns.  The puzzle was:";
  202.    lastx=guessnbr*29
  203.    FOR i=1 TO 5
  204.       lasty=i*12+10
  205.       CIRCLE (lastx,lasty),11,answer(i)+2
  206.       PAINT (lastx,lasty),answer(i)+2
  207.    NEXT i   
  208.  
  209. END IF
  210.  
  211. IF guessnbr<20 AND guessnbr < topscore THEN
  212.    SOUND 200,5,100,0
  213.    SOUND 500,5,100,0
  214.    SOUND 200,5,100,1
  215.    SOUND 500,5,100,1
  216.  
  217.    PRINT "You've got it!  And beat the topscore!";
  218. END IF
  219.    
  220. IF guessnbr<20 AND guessnbr > topscore THEN
  221.    SOUND 200,5,100,0
  222.    SOUND 500,5,100,0
  223.    SOUND 300,5,100,0
  224.    SOUND 200,5,100,1
  225.    SOUND 500,5,100,1
  226.    SOUND 300,5,100,1
  227.    PRINT "Well, you've got it, but you've done better.";
  228. END IF
  229.  
  230. IF guessnbr < topscore THEN topscore=guessnbr-1
  231.  
  232. PRINT  "  Press any key to continue.";
  233. GOSUB keywait
  234.  
  235. LOCATE 20,1:COLOR 4:PRINT "Top Score:  ";topscore;
  236. total=total+guessnbr
  237. games=games+1
  238. IF games>1 THEN COLOR 3:PRINT "  Average:  ";total/games
  239.  
  240. LINE (0,0)-(619,110),0,bf
  241.  
  242.       
  243. GOTO startgame
  244.  
  245. drawcredits:
  246. ' Draw Opening Credits
  247. 'set border to black as well
  248.  
  249. LOCATE 12,29
  250. PALETTE 1,0,0,0:PALETTE 3,1,1,1:COLOR 3
  251. PRINT "KenR Software Presents";
  252. FOR i=1 TO 1500:x=0.1:NEXT i
  253. FOR i=1 TO 0 STEP -0.02
  254.   PALETTE 3,i,i,i
  255.   SCROLL (0,0)-(639,220),0,-1
  256. NEXT i  
  257. CLS
  258. FOR i=3 TO 5
  259.    PALETTE i,0.01,0.01,0.01
  260. NEXT i
  261.  
  262. COLOR 3
  263. cl=3:cll=1
  264. notend = -1
  265. WHILE notend
  266.    READ x,y
  267.    IF x=0 AND y=0 THEN notend=0
  268.    newletter=1*notend
  269.    WHILE newletter
  270.       READ x1,y1
  271.       IF x1=0 AND y1=0 THEN
  272.          AREAFILL 
  273.          newletter=0
  274.       ELSE
  275.          AREA (x*15+40,y*10+10)
  276.          x=x1:y=y1
  277.       END IF
  278.    WEND
  279.    cl=cl+1:IF cl=6 THEN cl=3
  280.    COLOR cl
  281.          
  282. WEND
  283. y=0
  284. FOR z=0 TO 0.8 STEP 0.04
  285.    SOUND 130,1,z*100,0
  286.    SOUND 131,1,z*100,1
  287.    PALETTE 3,z,y,0
  288.    PALETTE 4,0,z,y
  289.    PALETTE 5,y,0,z
  290.    y=y+0.02
  291.    SOUND 130,1,z*100,0
  292.    SOUND 131,1,z*100,1
  293.    PALETTE 3,z,y,0
  294.    PALETTE 4,0,z,y
  295.    PALETTE 5,y,0,z
  296.  
  297. NEXT z
  298.  
  299. FOR j=1 TO 50
  300.    SOUND 130,1,80,0
  301.    SOUND 131,1,80,1
  302.    SOUND 130,0.1,0,0
  303.    SOUND 131,0.1,0,0
  304.    IF RND(1)>0.9 THEN
  305.       n1=RND(1):n2=RND(1):n3=RND(1)
  306.       PALETTE 0,n1,n2,n3
  307.       PALETTE 1,n1,n2,n3
  308.       SOUND 3900,0.3,127,2
  309.       SOUND 5000,0.3,127,3
  310.       PALETTE 0,0,0,0
  311.       PALETTE 1,0,0,0
  312.    END IF   
  313. NEXT j   
  314.  
  315.  
  316. FOR z=0.8 TO 0 STEP -0.02
  317.    SOUND 130,1,z*100,0
  318.    SOUND 131,1,z*100,1
  319.    SOUND 133,1,z*100,2
  320.    SOUND 134,1,z*100,3
  321.    PALETTE 3,z,0,0
  322.    PALETTE 4,0,z,0
  323.    PALETTE 5,0,0,z
  324. NEXT z
  325.  
  326. CLS
  327. PALETTE 3,0.8,0.6,0.53
  328. PALETTE 4,0.3,0.4,1
  329. PALETTE 5,1,0.13,0.93
  330. PALETTE 6,0.2,0.93,0.87
  331. PALETTE 1,0.7,0.7,0.7
  332.  
  333. SOUND 50,25,127,0
  334. SOUND 51,25,127,1
  335. SOUND 100,10,127,0
  336. SOUND 101,10,127,1
  337. FOR i=127 TO 0 STEP -20
  338.    SOUND 100,2,i,0
  339.    SOUND 101,2,i,1
  340. NEXT i
  341.  
  342.  
  343.  
  344. RETURN  
  345.   
  346.   
  347. DATA 30,11,30,5,33,7,32,10,30,11,0,0
  348. DATA 29,11,29,5,30,8,31,5,30,11,29.5,7,29,11,0,0
  349. DATA 28,11,27,8,28,5,29,8,28,11,0,0
  350. DATA 20,11,23,5,24,7,25,5,28,11,20,11,0,0
  351. DATA 18.5,11,18.5,5,22,6,20,8,22,11,19.5,8.5,18.5,11,0,0
  352. DATA 16,11,16,5,19,6,17,7,19,8,17,9,19,10,16,11,0,0
  353. DATA 14.5,11,14.5,6.5,13,5.5,15,5,17,5.5,15.5,6,15.5,11,14.5,11,0,0
  354. DATA 13,11,10,8,12,9,11,6,12,5,14,6,12,7,14,10,13,11,0,0
  355. DATA 8,11,10,5,12,11,8,11,0,0
  356. DATA 0,11,3,0,4,4,5,0,10,11,0,11,0,0
  357. DATA 0,0
  358.  
  359. help:
  360.  
  361. LOCATE 12,1
  362. COLOR 5
  363. PRINT "This is the game of Mastermind.  Originally by Parker Brothers, the";
  364. LOCATE 13,1
  365. PRINT "object of the game is to guess the 5 colors of the pegs in the";
  366. LOCATE 14,1
  367. PRINT "puzzle." ;
  368. LOCATE 15,1
  369. PRINT  "   These colors may be of any of the 8 boxes below, each of which";
  370. LOCATE 16,1
  371. PRINT "correspond to a function key on your keyboard.  (Novel idea, eh?)";
  372. LOCATE 17,1
  373. COLOR 1
  374. PRINT "Press any key to go on.";
  375. GOSUB keywait
  376.  
  377. ' clear area
  378. LINE (0,80)-(639,170),0,bf
  379. COLOR 6
  380. LOCATE 12,1
  381. PRINT "As you make each guess, the round cursor will automatically advance to";
  382. LOCATE 13,1
  383. PRINT "the next space.  You can use the up and down cursor keys to move the cursor";
  384. LOCATE 14,1
  385. PRINT  "as well.";
  386. COLOR 1
  387. LOCATE 15,1
  388. PRINT  "Press any key to go on.";
  389.  
  390. GOSUB keywait
  391. ' clear area
  392. LINE (0,80)-(639,170),0,bf
  393. LOCATE 12,1:COLOR 7
  394. PRINT  "   After you are satisfied that your guess is what you want, press F10";
  395. LOCATE 13,1
  396. PRINT  "(The box that has 'Go' in it) to register your guess.";
  397. LOCATE 14,1
  398. PRINT  "   The Amiga will tell you if   1) A 'peg' is in the right spot";
  399. LOCATE 15,1
  400. PRINT  "                           or   2) The color is correct, but the spot";
  401. LOCATE 16,1
  402. PRINT  "                                   is not.";
  403. LOCATE 17,1
  404. PRINT  "These are signified by a black circle and a white circle respectively.";
  405.           
  406. COLOR 1
  407. LOCATE 18,1
  408. PRINT  "Press any key to go on.";
  409.  
  410. GOSUB keywait
  411. ' clear area
  412. LINE (0,80)-(639,170),0,bf
  413. LOCATE 12,1:COLOR 8
  414. PRINT  " - All spots must be full in order to make a guess." ;
  415. LOCATE 13,1
  416. PRINT  " - The pegs will all be different colors, unless you want a harder";
  417. LOCATE 14,1
  418. PRINT  "   game - in which case, press F9 when you exit help (or when you start";
  419. LOCATE 15,1
  420. PRINT  "up the game next time.)";
  421. LOCATE 16,1
  422. COLOR 9
  423. PRINT  "By the way, you can only access help UNTIL you make a guess.  After that,";
  424. LOCATE 17,1
  425. PRINT  "I'd think you're asking for a hint.  I MAY give you one, but it'll cost.";
  426. COLOR 1
  427. LOCATE 18,1
  428. PRINT  "Press any key to go back.";
  429.  
  430. GOSUB keywait
  431. ' clear area
  432. LINE (0,80)-(639,170),0,bf
  433. LOCATE 12,1:COLOR 9
  434.  
  435. RETURN
  436.  
  437. keywait:
  438. ' first clear the buffer
  439. nochar=-1
  440. WHILE nochar
  441.    a$=INKEY$
  442.    IF LEN(a$)=0 THEN  nochar=0
  443. WEND
  444.  
  445. ' now wait for the next key
  446. nochar=-1
  447. WHILE nochar
  448.    a$=INKEY$
  449.    IF LEN(a$)<>0 THEN nochar=0
  450. WEND      
  451.  
  452. RETURN                                                 
  453.                                                  
  454. hint:
  455.  
  456. LOCATE 1,1
  457. COLOR 8
  458. PRINT  "Hints are not available in this version.";
  459. RETURN
  460.  
  461.  
  462.